TERMS.NEW[1,JRA] - www.SailDart.org

perm filename TERMS.NEW[1,JRA] blob sn#005807 filedate 1972-09-13 generic text, type T, neo UTF8


(DEFPROP TERMS 
 (LAMBDA (X Y Z) (CDR (TERMS2 X Y Z))) 
EXPR)

(DEFPROP TERMS2 
 (LAMBDA(Z L N)
  (PROG (Z1 T1 T2)
	(SETQ T2 (SETQ T1 (LIST NIL)))
   A    (COND ((NULL L) (RETURN T1))
	      ((VAR (CAR L)) (GO B))
	      ((CONST (CAR L)) (RPLACA T1 T)
			       (COND ((EQ Z (CAAR L)) (RPLACD T2 (LIST L)) (SETQ T2 (CDR T2))))
			       (GO B))
	      ((EQ N 1) (GO B)))
	(SETQ Z1 (TERMS2 Z (CDAR L) (SUB1 N)))
	(COND ((AND (CAR Z1) (EQ (CAAR L) Z)) (RPLACA T1 T) (RPLACD T2 (LIST L)) (SETQ T2 (CDR T2))))
	(COND ((CDR Z1) (RPLACD T2 (CDR Z1)) (SETQ T2 (LAST T2))))
   B    (SETQ L (CDR L))
	(GO A))) 
EXPR)